(** Module GenElkTokens contains:
 *  - function, which generates file with tokens
 *
 *  Author: Ilia
 *)

open IL
open Misc.Generation
open Production
open Namer
open Diagnostics

let genTok (* num tokEntry *) = sprintf "%d : %s ;\n" (* num tokEntry *)

let rec genToks num = function
    | []   -> ""
    | h::t -> 
      let tokEntry = 
        let tok = getText h in 
          if tok.[0] = '\"' 
          then sprintf "%s %s" (createLiteralToken num ) tok
          else tok
      in sprintf "%s%s" (genTok num tokEntry) (genToks (succ num) t)

let genTokType num tokName = 
    sprintf "token(%s) %s;\n" (withTokenPrefix (string_of_int num)) tokName

let genLiteralType num = let literal = createLiteralToken num in
    genTokType num literal

let rec genTokTypes num = function
    | []   -> ""
    | h::t -> 
      let tokType = 
        let tok = getText h in
          if tok.[0] <> '\"' then genTokType num tok
          else genLiteralType num
      in sprintf "%s%s" tokType (genTokTypes (succ num) t)

let genTokList = function 
    | [] -> reportError "there are no tokens" ; ""
    | l  -> (** Elkhound requires that EOF has number 0 *)
              (genTok 0 getEofTokenName) 
            ^ (genToks 1 l) ^ "\n" ^ (genTokTypes 1 l)
            

let insertToTokList tok tokList =
    try 
      let _ = List.find (fun x -> getText tok = getText x) tokList 
      in tokList 
    with Not_found -> tok::tokList

let rec collectFromRule tokList = function
    | PAlt (l, r) -> let toks = collectFromRule tokList l 
      in collectFromRule toks r       
    | PSeq (seq, _) -> 
      let rec collectFromSeq toks = function
          | []   -> toks
          | h::t -> 
            let toks' = collectFromRule toks h.rule 
            in collectFromSeq toks' t          
      in collectFromSeq tokList seq 
    | POpt r | PSome r | PMany r -> collectFromRule tokList r
    | PToken t | PLiteral t -> insertToTokList t tokList
    | PMetaRef (_, _, mArgs) -> 
      let rec collectFromList toks = function
      | [] -> toks
      | h::t -> 
        let toks' = let s = getText h in
          (* we check that 1-st letter is in upper case (for token)
           * or is forward quote for literal
           *)
          if s = String.capitalize s || s.[0] = '\"'
          then insertToTokList h toks 
          else toks
        in collectFromList toks' t
      in collectFromList tokList mArgs

    | PRef (_, _) -> tokList

let rec collectTokens tokList = function
    | []   -> tokList
    | h::t -> let toks = collectFromRule tokList h.Rule.body 
      in collectTokens toks t

(** main function *)
let genTokens tokFile gram = 
    let tokens = collectTokens [] gram in
    let text = genTokList tokens in
    let outChan = open_out_bin tokFile in 
    output_string outChan text
